home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / lex / ml.lex next >
Encoding:
Text File  |  1993-01-27  |  8.9 KB  |  225 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. open ErrorMsg;
  4.  
  5. structure TokTable = TokenTable(Tokens);
  6. type svalue = Tokens.svalue
  7. type pos = int
  8. type lexresult = (svalue,pos) Tokens.token
  9. type lexarg = {comLevel : int ref, 
  10.            lineNum : int ref,
  11.                linePos : int list ref, (* offsets of lines in file *)
  12.            charlist : string list ref,
  13.            stringstart : int ref, (* start of current string or comment*)
  14.                brack_stack : int ref list ref, (* for frags *)
  15.            err : pos*pos -> ErrorMsg.complainer}
  16. type arg = lexarg
  17. type ('a,'b) token = ('a,'b) Tokens.token
  18. val eof = fn ({comLevel,err,linePos,stringstart,
  19.                lineNum,charlist, brack_stack}:lexarg) => 
  20.        let val pos = Integer.max(!stringstart+2, hd(!linePos))
  21.         in if !comLevel>0 then err (!stringstart,pos) COMPLAIN
  22.                      "unclosed comment" nullErrorBody
  23.                     else ();
  24.            Tokens.EOF(pos,pos)
  25.        end    
  26. fun addString (charlist,s:string) = charlist := s :: (!charlist)
  27. fun makeString charlist = (implode(rev(!charlist)) before charlist := nil)
  28. fun makeHexInt sign s = let
  29.       fun digit d = if (d < Ascii.uc_a) then (d - Ascii.zero)
  30.         else (10 + (if (d < Ascii.lc_a) then (d - Ascii.uc_a) else (d - Ascii.lc_a)))
  31.       in
  32.     revfold (fn (c,a) => sign(a*16, digit(ord c))) (explode s) 0
  33.       end
  34. fun makeInt sign s =
  35.     revfold (fn (c,a) => sign(a*10, ord c - Ascii.zero)) (explode s) 0
  36.  
  37. local
  38. val quote = ord "`"
  39. in
  40. fun has_quote s =
  41.    let fun loop i = (ordof(s,i) = quote orelse loop (i+1))
  42.                     handle Ord => false
  43.    in
  44.    loop 0
  45.    end
  46. end;
  47.    
  48. %% 
  49. %reject
  50. %s A S F Q AQ;
  51. %header (functor MLLexFun(structure Tokens : ML_TOKENS));
  52. %arg ({comLevel,lineNum,err,linePos,charlist,stringstart,brack_stack});
  53. idchars=[A-Za-z'_0-9];
  54. id=[A-Za-z]{idchars}*;
  55. ws=("\012"|[\t\ ])*;
  56. full_sym=[!%&$+/:<=>?@~|#*`]|\\|\-|\^;
  57. sym=[!%&$+/:<=>?@~|#*]|\\|\-|\^;
  58. quote="`";
  59. num=[0-9]+;
  60. frac="."{num};
  61. exp="E"(~?){num};
  62. real=(~?)(({num}{frac}?{exp})|({num}{frac}{exp}?));
  63. hexnum=[0-9a-fA-F]+;
  64. %%
  65. <INITIAL>{ws}    => (continue());
  66. <INITIAL>\n    => (inc lineNum; linePos := yypos :: !linePos; continue());
  67. <INITIAL>"_"    => (Tokens.WILD(yypos,yypos+1));
  68. <INITIAL>","    => (Tokens.COMMA(yypos,yypos+1));
  69. <INITIAL>"{"    => (Tokens.LBRACE(yypos,yypos+1));
  70. <INITIAL>"}"    => (Tokens.RBRACE(yypos,yypos+1));
  71. <INITIAL>"["    => (Tokens.LBRACKET(yypos,yypos+1));
  72. <INITIAL>"#["    => (Tokens.VECTORSTART(yypos,yypos+1));
  73. <INITIAL>"]"    => (Tokens.RBRACKET(yypos,yypos+1));
  74. <INITIAL>";"    => (Tokens.SEMICOLON(yypos,yypos+1));
  75. <INITIAL>"("    => (if (null(!brack_stack))
  76.                     then ()
  77.                     else inc (hd (!brack_stack));
  78.                     Tokens.LPAREN(yypos,yypos+1));
  79. <INITIAL>")"    => (if (null(!brack_stack))
  80.                     then ()
  81.                     else if (!(hd (!brack_stack)) = 1)
  82.                          then ( brack_stack := tl (!brack_stack);
  83.                                 charlist := [];
  84.                                 YYBEGIN Q)
  85.                          else dec (hd (!brack_stack));
  86.                     Tokens.RPAREN(yypos,yypos+1));
  87. <INITIAL>"."        => (Tokens.DOT(yypos,yypos+1));
  88. <INITIAL>"..."        => (Tokens.DOTDOTDOT(yypos,yypos+3));
  89. <INITIAL>"'"("'"?)("_"|{num})?{id}
  90.             => (TokTable.checkTyvar(yytext,yypos));
  91. <INITIAL>{id}            => (TokTable.checkToken(yytext,yypos));
  92. <INITIAL>{full_sym}+    => (if (!System.Control.quotation)
  93.                             then if (has_quote yytext)
  94.                                  then REJECT()
  95.                                  else TokTable.checkToken(yytext,yypos)
  96.                             else TokTable.checkToken(yytext,yypos));
  97. <INITIAL>{sym}+         => (TokTable.checkToken(yytext,yypos));
  98. <INITIAL>{quote}        => (if (!System.Control.quotation)
  99.                             then (YYBEGIN Q;
  100.                                   charlist := [];
  101.                                   Tokens.BEGINQ(yypos,yypos+1))
  102.                             else (err(yypos, yypos+1)
  103.                                      COMPLAIN "quotation implementation error"
  104.                      nullErrorBody;
  105.                                   Tokens.BEGINQ(yypos,yypos+1)));
  106. <INITIAL>{real}    => (Tokens.REAL(yytext,yypos,yypos+size yytext));
  107. <INITIAL>[1-9][0-9]* => (Tokens.INT(makeInt (op +) yytext
  108.             handle Overflow => (err (yypos,yypos+size yytext)
  109.                       COMPLAIN "integer too large"
  110.                       nullErrorBody;
  111.                         1),
  112.             yypos,yypos+size yytext));
  113. <INITIAL>{num}    => (Tokens.INT0(makeInt (op +) yytext
  114.             handle Overflow => (err (yypos,yypos+size yytext)
  115.                       COMPLAIN "integer too large"
  116.                       nullErrorBody; 0),
  117.             yypos,yypos+size yytext));
  118. <INITIAL>~{num}    => (Tokens.INT0(makeInt (op -)
  119.                     (substring(yytext,1,size(yytext)-1))
  120.             handle Overflow => (err (yypos,yypos+size yytext)
  121.                      COMPLAIN "integer too large"
  122.                      nullErrorBody;
  123.                         0),
  124.             yypos,yypos+size yytext));
  125. <INITIAL>"0x"{hexnum} => (
  126.             Tokens.INT0(makeHexInt (op +) (substring(yytext, 2, size(yytext)-2))
  127.                 handle Overflow => (err (yypos,yypos+size yytext)
  128.                           COMPLAIN "integer too large"
  129.                           nullErrorBody;
  130.                         0),
  131.               yypos, yypos+size yytext));
  132. <INITIAL>"~0x"{hexnum} => (
  133.             Tokens.INT0(makeHexInt (op -) (substring(yytext, 3, size(yytext)-3))
  134.                 handle Overflow => (err (yypos,yypos+size yytext)
  135.                           COMPLAIN "integer too large"
  136.                           nullErrorBody;
  137.                         0),
  138.               yypos, yypos+size yytext));
  139. <INITIAL>\"    => (charlist := [""]; stringstart := yypos;
  140.             YYBEGIN S; continue());
  141. <INITIAL>"(*"    => (YYBEGIN A; stringstart := yypos; comLevel := 1; continue());
  142. <INITIAL>"*)"    => (err (yypos,yypos+1) COMPLAIN "unmatched close comment"
  143.                 nullErrorBody;
  144.             continue());
  145. <INITIAL>\h    => (err (yypos,yypos) COMPLAIN "non-Ascii character"
  146.                 nullErrorBody;
  147.             continue());
  148. <INITIAL>.    => (err (yypos,yypos) COMPLAIN "illegal token" nullErrorBody;
  149.             continue());
  150. <A>"(*"        => (inc comLevel; continue());
  151. <A>\n        => (inc lineNum; linePos := yypos :: !linePos; continue());
  152. <A>"*)" => (dec comLevel; if !comLevel=0 then YYBEGIN INITIAL else (); continue());
  153. <A>.        => (continue());
  154. <S>\"            => (YYBEGIN INITIAL; Tokens.STRING(makeString charlist,
  155.                 !stringstart,yypos+1));
  156. <S>\n        => (err (!stringstart,yypos) COMPLAIN "unclosed string"
  157.                 nullErrorBody;
  158.             inc lineNum; linePos := yypos :: !linePos;
  159.             YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos));
  160. <S>[^"\\\n]*    => (addString(charlist,yytext); continue());
  161. <S>\\\n               => (inc lineNum; linePos := yypos :: !linePos;
  162.             YYBEGIN F; continue());
  163. <S>\\[\ \t]       => (YYBEGIN F; continue());
  164. <F>\n        => (inc lineNum; linePos := yypos :: !linePos; continue());
  165. <F>{ws}        => (continue());
  166. <F>\\        => (YYBEGIN S; stringstart := yypos; continue());
  167. <F>.        => (err (!stringstart,yypos) COMPLAIN "unclosed string"
  168.                 nullErrorBody; 
  169.             YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos+1));
  170. <S>\\t        => (addString(charlist,"\t"); continue());
  171. <S>\\n        => (addString(charlist,"\n"); continue());
  172. <S>\\\\        => (addString(charlist,"\\"); continue());
  173. <S>\\\"        => (addString(charlist,chr(Ascii.dquote)); continue());
  174. <S>\\\^[@-_]    => (addString(charlist,chr(ordof(yytext,2)-ord("@"))); continue());
  175. <S>\\[0-9]{3}    =>
  176.  (let val x = ordof(yytext,1)*100
  177.          +ordof(yytext,2)*10
  178.          +ordof(yytext,3)
  179.          -(Ascii.zero*111)
  180.   in (if x>255
  181.       then err (yypos,yypos+4) COMPLAIN "illegal ascii escape" nullErrorBody
  182.       else addString(charlist,chr x);
  183.       continue())
  184.   end);
  185. <S>\\        => (err (yypos,yypos+1) COMPLAIN "illegal string escape"
  186.                 nullErrorBody; 
  187.             continue());
  188.  
  189.  
  190. <Q>"^"          => (YYBEGIN AQ;
  191.                     let val x = makeString charlist
  192.                     in
  193.                     Tokens.OBJL(x,yypos,yypos+(size x))
  194.                     end);
  195. <Q>"`"          => ((* a closing quote *)
  196.                     YYBEGIN INITIAL;
  197.                     let val x = makeString charlist
  198.                     in
  199.                     Tokens.ENDQ(x,yypos,yypos+(size x))
  200.                     end);
  201. <Q>\n           => (inc lineNum; addString(charlist,"\n"); continue());
  202. <Q>.            => (addString(charlist,yytext); continue());
  203.  
  204. <AQ>\n          => (inc lineNum; continue());
  205. <AQ>{ws}        => (continue());
  206. <AQ>{id}        => (YYBEGIN Q; 
  207.                     let val hash = StrgHash.hashString yytext
  208.                     in
  209.                     Tokens.AQID(FastSymbol.rawSymbol(hash,yytext),
  210.                 yypos,yypos+(size yytext))
  211.                     end);
  212. <AQ>{sym}+      => (YYBEGIN Q; 
  213.                     let val hash = StrgHash.hashString yytext
  214.                     in
  215.                     Tokens.AQID(FastSymbol.rawSymbol(hash,yytext),
  216.                 yypos,yypos+(size yytext))
  217.                     end);
  218. <AQ>"("         => (YYBEGIN INITIAL;
  219.                     brack_stack := ((ref 1)::(!brack_stack));
  220.                     Tokens.LPAREN(yypos,yypos+1));
  221. <AQ>.           => (err (yypos,yypos+1) COMPLAIN
  222.                ("ml lexer: bad character after antiquote "^yytext)
  223.                nullErrorBody;
  224.                     Tokens.AQID(FastSymbol.rawSymbol(0,""),yypos,yypos));
  225.